;******************************************************************
;**                                                              **
;**                  Acorn RISCOS MIDI Software                  **
;**                                                              **
;**    MODULE: MIDI for use with MIDI/io podule                  **
;**            or MIDI podule or MIDI/user port                  **
;**                                                              **
;**    AUTHOR: J. Sutton                                         **
;**            Cherry Hinton x5272                               **
;**                                                              **
;**    DATE:   Last edit 9-Aug-89                                **
;**                                                              **
;**    VERSION: 3.14                                             **                                            **
;**                                                              **
;**    DESCRIPTION: Musical Instruments Digital Interface (MIDI) **
;**                                                              **
;**    ENTRIES: SWIs for system level interface                  **
;**             IRQ  to load and store UART/ACIA                 **
;**             SIRQ from SoundDMA module to drive sound         **
;**                  and realtime stuff, approx every 0.01s      **
;**             Escape Event to update VoiceStates byte, since   **
;**                    voices are turned off automatically       **
;**             Sound Event to update bar counter for time-      **
;**                    stamping of incoming MIDI data.           **
;**             Uses Sound System modules 0, 1 and 2             **
;**                  (SoundDMA, SoundChannels, and               **
;**                   SoundScheduler)                            **
;**                  these must therefore be loaded for          **
;**                     proper function of this module.          **
;**             OSCLI for simple command-line control            **
;**                                                              **
;**    CHANGES:                                                  **
;**      16/5/88 : Release 2                                     **
;**       5/5/89 : Release 3.05                                  **
;**      15/5/89 : fixed bugs reported from SQA                  **
;**              : Release 3.06                                  **
;**      22/5/89 : fixed bug midi interpreter buffer pointer set **
;**                and initialisation (in SWI MIDI_SoundEnable)  **
;**              : Release 3.08                                  **
;**      25/5/89 : STR [MonoChanels] changed to STRB in          **
;**        interpreter.                                          **
;**        In TxNoteOff changed LDRB [SendStatus] to load from   **
;**        the correct port offset (was 0).                      **
;**        In ResetHardware specifically disable ACIA IRQ, to    **
;**        cure a specific problem of IRQ causing machine to     **
;**        stiff on reset when receiving data. (IO podule only)  **
;**      26/5/89  : disable irq AND fiq when changing IOCIRQMSKB **
;**               : Release 3.10                                 **
;**      30/5/89  : intercept_services, service_sound, check     **
;**        for and invalidate return from sound_configure with   **
;**        centisecond_code address. (rmreinit sounddma does not **
;**        reinstall level2 handler)                             **
;**               : Release 3.11                                 **
;**      14/7/89  : ms_count NOT reset to 0 in StartTimerIRQ so  **
;**      programmed value in r1 in SWI MIDI_FastClock can set it **
;**               : Release 3.12                                 **
;**      24/7/89  : Special version for use with Teknomusik's    **
;**                 special hardware
;**               : changed special bit in uart address offset
;**               (used to distinguish acia/uart) from bit 11 to bit 21
;**               with reversed sense, for compatibility with their
;**               hardware.
;**               : corrected error in GetDeviceAddresses
;**               (routine cleared all device address offsets to zero
;**               before reading them)
;**               : split one source file into 6.
;**               : Released version 3.13 for Teknomusik         **
;**
;**   9/8/89  : correct error in OS_ReadUnsigned param to limit
;**             maximum values in oscli commands.
;**           : contentious keyboard buffer-flush on sound swi
;**             error removed.
;**           : *midisound corrected so that it always sets r1 to 0
;**             before calling SWI Midi_SoundEnable
;**           : Modified RxByte and RxCommand to only report buffer
;**             overflow error on the the interrogated port.
;**           : return 1 less from txcommand in r1 for scheduler slots
;**             free. Previous range was (1023..1, -1). (didn't return 0)
;**             Range is now (1022..0, -1)
;**           : corrected error in UnknownPodule: STR R1.. (was STR R3..)
;**           : tidied irqcode
;**               : Release 3.14                                 **
;******************************************************************

        GET     <urd>.Hdr.ListOpts  ; These first three must be in this order
        GET     <urd>.Hdr.Macros
        GET     <urd>.Hdr.System    ; SWI declarations, register names

        GET     <urd>.Hdr.Services
        GET     <urd>.Hdr.ModHand
        GET     <urd>.Hdr.NewErrors

        GET     <urd>.Hdr.NewSpace
        GET     <urd>.Hdr.Sound
        GET     <urd>.Hdr.Podule
        GET     <urd>.Hdr.DevNos
        GET     <urd>.Hdr.MIDI
        GET     <dir>.MidiPodule.Hdr.MIDIStatus   ; values of midi status bytes as defined by MIDI spec. 1.0
        GET     <dir>.MidiPodule.Hdr.ACIA   ; details of register offsets, addresses etc. for acia
        GET     <dir>.MidiPodule.Hdr.UART   ; ditto for uart
        GET     <dir>.MidiPodule.Hdr.VIA    ; ditto for VIA in MIDI/IO podule
        GET     <dir>.MidiPodule.Version

    LEADR Module_LoadAddr

MySWIChunkBase * Module_SWISystemBase + MIDISWI * Module_SWIChunkSize

 ASSERT MySWIChunkBase      = MIDI_SoundEnable
 ASSERT MySWIChunkBase+37-1 = MIDI_Interface ; check SWI numbers

Module_Base                 ; Label for calculating offsets
     &   0                               ; This module is not an application
     &   Initialise_Module  - Module_Base
     &   Finalise_Module    - Module_Base
     &   Intercept_Services - Module_Base
     &   Title_String       - Module_Base
     &   Help_String        - Module_Base
     &   Module_Keywords    - Module_Base
     &   MySWIChunkBase                       ; SWI chunk number
     &   MIDI_SWI_Code      - Module_Base     ; SWI handler code
     &   MIDI_SWI_Table     - Module_Base     ; SWI decoding table
     &   0                                    ; no SWI decoding code

Title_String = "MIDI",0

Help_String
   =       "MIDI podule", 9, Version
   =       " (", CurrentDate, ")"
   =       0

; to make SURE the assembled module is the correct version
check_version = "*V3.14/9/8/89*",0

MIDI_SWI_Table
  = "MIDI",0
  = "SoundEnable",0             ;1
  = "SetMode",0                 ;2
  = "SetTxChannel",0            ;3
  = "SetTxActiveSensing",0      ;4
  = "InqSongPositionPointer",0  ;5
  = "InqBufferSize",0           ;6
  = "InqError",0                ;7
  = "RxByte",0                  ;8
  = "RxCommand",0               ;9
  = "TxByte",0                  ;10
  = "TxCommand",0               ;11
  = "TxNoteOff",0               ;12
  = "TxNoteOn",0                ;13
  = "TxPolyKeyPressure",0       ;14
  = "TxControlChange",0         ;15
  = "TxLocalControl",0          ;16
  = "TxAllNotesOff",0           ;17
  = "TxOmniModeOff",0           ;18
  = "TxOmniModeOn",0            ;19
  = "TxMonoModeOn",0            ;20
  = "TxPolyModeOn",0            ;21
  = "TxProgramChange",0         ;22
  = "TxChannelPressure",0       ;23
  = "TxPitchWheel",0            ;24
  = "TxSongPositionPointer",0   ;25
  = "TxSongSelect",0            ;26
  = "TxTuneRequest",0           ;27
  = "TxStart",0                 ;28
  = "TxContinue",0              ;29
  = "TxStop",0                  ;30
  = "TxSystemReset",0           ;31
  = "IgnoreTiming",0            ;32
  = "SynchSoundScheduler",0     ;33
  = "FastClock",0               ;34
  = "Init",0                    ;35
  = "SetBufferSize",0           ;36
  = "Interface",0               ;37
  = 0

Module_Keywords

  =     "MidiSound",0
  ALIGN
  &      MidiSound_Code   - Module_Base
  =      1,0,2,0                       ; 1 parameter
  &      MidiSound_Syntax - Module_Base
  &      MidiSound_Help   - Module_Base

  =     "MidiTouch",0
  ALIGN
  &      MidiTouch_Code   - Module_Base
  =      1,0,1,0                       ; one parameter
  &      MidiTouch_Syntax - Module_Base
  &      MidiTouch_Help   - Module_Base

  =     "MidiChannel",0
  ALIGN
  &      MidiChannel_Code   - Module_Base
  =      1,0,1,0                       ; 1 parameter
  &      MidiChannel_Syntax - Module_Base
  &      MidiChannel_Help   - Module_Base

  =     "MidiMode",0
  ALIGN
  &      MidiMode_Code   - Module_Base
  =      1,0,1,0                       ; 1 parameter
  &      MidiMode_Syntax - Module_Base
  &      MidiMode_Help   - Module_Base

  =     "MidiStart",0
  ALIGN
  &      MidiStart_Code   - Module_Base
  =      0,0,1,0                       ; no parameters
  &      MidiStart_Syntax - Module_Base
  &      MidiStart_Help   - Module_Base

  =     "MidiContinue",0
  ALIGN
  &      MidiContinue_Code   - Module_Base
  =      0,0,0,0                       ; no parameters
  &      MidiContinue_Syntax - Module_Base
  &      MidiContinue_Help   - Module_Base

  =     "MidiStop",0
  ALIGN
  &      MidiStop_Code   - Module_Base
  =      0,0,0,0                       ; no parameters
  &      MidiStop_Syntax - Module_Base
  &      MidiStop_Help   - Module_Base

  = 0        ; no more keywords

MidiSound_Help
  =  "*MidiSound causes incoming or outgoing MIDI data to play the internal",13
  =  "sound voices. Can also specify the Midi Port number.",13
MidiSound_Syntax
  =  "Syntax: *MidiSound <'off', 'in' or 'out'> (<1..4>)",0

MidiTouch_Help
  =  "*MidiTouch enables or disables touch response (key velocity) of the MIDI interpreter",13
MidiTouch_Syntax
  =  "Syntax: *MidiTouch <'off' or 'on'>",0

MidiChannel_Help
  =  "*MidiChannel sets the MIDI Basic Channel of the MIDI interpreter",13
  =  "(enabled with *MidiSound)",13
MidiChannel_Syntax
  =  "Syntax: *MidiChannel <1..16>",0

MidiMode_Help
  =  "*MidiMode sets the Mode of the MIDI interpreter (enabled with *MidiSound)",13
  =  " Mode 1 : OMNI ON,  POLY",9,9,"Mode 2 : OMNI ON,  MONO",13
  =  " Mode 3 : OMNI OFF, POLY",9,9,"Mode 4 : OMNI OFF, MONO",13
MidiMode_Syntax
  =  "Syntax: *MidiMode <1..4>",0

MidiStart_Help
  =  "*MidiStart sends a MIDI Start message, resets the MIDI Song Position Pointer,",13
  =  "and starts automatic transmission of Timing Clock messages every t milliseconds,",13
  =  "where t is the parameter (if specified)",13
MidiStart_Syntax
  =  "Syntax: *MidiStart (<time>)",0

MidiContinue_Help
  =  "*MidiContinue sends a MIDI Continue message, and restarts automatic transmission",13
  =  "of Timing Clock messages",13
MidiContinue_Syntax
  =  "Syntax: *MidiContinue",0

MidiStop_Help
  =  "*MidiStop sends a MIDI Stop message, and stops automatic transmission of",13
  =  "Timing Clock messages",13
MidiStop_Syntax
  =  "Syntax: *MidiStop",0

         ALIGN

; NB The podule returns byte quantities
PoduleZeroAddress * &033C0000  ; use this if not initialised by podule manager

WorkSpaceSize & WorkSpace

TxBufferLen * 512 ; size of transmit buffer
DefaultRxBufferLen * 1024 ; default size of receive buffer, is reprogrammable

OsbyteSetEscapeCondition * &7D
OsbyteDisableEvent       * &0D
OsbyteEnableEvent        * &0E
OsbyteReadLastBreak      * &FD

SlowClock * 20 ; some things only need doing every 20 centiseconds

PoduleNumberShift * 14 ; shift right the podule base address by this to get the podule number in the bottom 2 bits

IDShift      * 24   ; shift the extended ID from SWI Podule_ReadHeader to get ID of podule in bottom byte (6 or 19)

;convenient means of determining which type of Port from UART base address:
PortTypeTestBit * &200000  ; is 1 for uart Ports, (stand-alone MIDI); 0 for ACIAs (MIDI/io podule)

MaxVoices * 8          ; maximum number of internal voices

MaxRunningStatusAge * 4 ; maximum age of sent running status. It will miss
                        ; this number of status bytes max

MaxTxInactivity * 28 ; This is the number of cs interrupts of inactivity, if
                     ; active sensing enabled (=280ms)
MaxRxInactivity * 35 ; This is the max. no. of centisec interrupts without MIDI
                  ; activity, if active sensing is enabled, before turning off
                  ; all voices. (=350ms)

; Internal Song Position Pointer is not true SPP. It is the number of MIDI
; clocks since Start. True SPP = internal SPP/6

TempoUnit      * &1000  ; this is 1 tempo count per centisecond
BeatCount      * 16 ; this is number of sound system beats per MIDI
                    ; Timing Clock transmitted

; Ignore status, to determine which received commands to ignore:
IgnoreTimingBit  * 2_00000001

TimerTicksFor1ms * 1000*2 ;  = 1ms

; ModeFlagBits definitions
; a large amount of the global state is in 1-bit flags in 1 32-bit word (ModeFlagBits)

; timing mode flags
InternalCount * 1       ; internal count enabled (has priority)
ExternalCount * 1:SHL:1 ; ext count enabled (only if InternalCount=0)

BufferFilling * 1:SHL:2 ; set when receive buffer pointer is incremented from 0
                        ; Used as a signal to generate an MidiBufferNotEmpty event

; timing mode should always be set by the centisecond routine
; These bits pass instructions to reset timing mode from the irq
; routine to the centisecond routine on receipt of Real Time messages
SetExternalC   * 1:SHL:3 ;centisecond routine should set External Timing mode
ClearExternalC * 1:SHL:4 ;centisecond routine should clear External Timing mode

; bits 5..7 are instructions from the centisecond routine to the
; IRQ routine to send a real time message.
InfoShift    * 5
SendRT       * 7:SHL:InfoShift ;irq routine should send a real time message
SendStart    * (1+StartVal-TimingClockVal):SHL:InfoShift ;irq routine should send a Start
SendCont     * (1+ContinueVal-TimingClockVal):SHL:InfoShift ;irq routine should send a Continue
SendStop     * (1+StopVal-TimingClockVal):SHL:InfoShift ;irq routine should send a Stop
SendTC       * 1:SHL:InfoShift ;irq routine should send a Timing Clock
; (ends at bit 7)

BackgroundError     * 1:SHL:8 ; irq routine detected an error

RxBufferOverflow    * 1:SHL:9 ; set on receive buffer overflowing; cleared on reporting
                              ; error from SWI MIDI_RxByte or RxCommand

; slight complication of internal state needed because Song Position Pointer
; is updated by the irq routine, and it is received in 3 separate bytes.
; status, then lsb, then msb.
SPPawaitLsb         * 1:SHL:10 ; => SPP status received, awaiting lsbyte
SPPawaitMsb         * 1:SHL:11 ; => SPP lsbyte received, awaiting msbyte

; Sound enable flags:
SoundEnableBit      * 1:SHL:12  ; sound system ENABLED/disabled
ConnectionBit       * 1:SHL:13  ; sound sys connected to in/OUT

FastClock           * 1:SHL:14 ; set if fast (1ms) clock is running
WasFastClock        * 1:SHL:15 ; set if fast clock was running, and should be auto-restarted asap

Version3Facilities  * 1:SHL:16 ; set after calling SWI MIDI_FastClock to enable new facilities
                                ; ensuring compatibility with old software

; flag set if sound scheduler is to be synchronised to the incoming MIDI Timing Clock messages
SynchSoundScheduler * 1:SHL:17

; other mode flags:
ModeFlagsShift   * 18
PolyBit          * 2_0001:SHL:ModeFlagsShift ; POLY/mono flag
OmniBit          * 2_0010:SHL:ModeFlagsShift ; omni ON/off flag
RxActiveSenseBit * 2_0100:SHL:ModeFlagsShift ; Rx active sensing ON/off
TxActiveSenseBit * 2_1000:SHL:ModeFlagsShift ; Tx active sensing ON/off
DefaultMode      * 2_0011:SHL:ModeFlagsShift ; no active sense, mode 1
; (ends at bit 21)

; irq re-entrancy prevention:
InIrq            * 1:SHL:22 ; set during irq routine. Prevents re-entrancy
              ; (irq can call scheduler which can call MIDI_Tx SWI, which can cause irq)

WarnedEmptyScheduler * 1:SHL:23 ; set when EmptyingScheduler event given 

; touch sensitivity of interpreter can now be disabled (inversion to give default value zero = on)
TouchSenseOff       * 1:SHL:24

NExtraPortsShift * 25  ; bits 25 and 26 are a 0..3 count of how many extra
                         ; (more than 1) midi Ports are installed
;NExtraPorts    * 2_11:SHL:25
; (ends at bit 26)

StoreSysRealTime     * 1:SHL:27 ; set if required (unusually) to store Real Time messages in the receive buffer
SysRealTimeNoExec    * 1:SHL:28 ; set if required (unusually) not to execute system real time messages

; record of which sound modules are installed
Sound0Present * 1:SHL:29
Sound1Present * 1:SHL:30
Sound2Present * 1:SHL:31

QEmptyWarningTime * 20  ; give scheduler emptying warning 20ms or 20 Timing Clocks
                        ; before it happens

         ALIGN

; *** include MIDI CLI command code ***

           GET <dir>.MidiPodule.OSCli

; ************************************ 

VIAprogram  ROUT  ;enable io podule irqs by poking values into the VIA
     STMFD   sp!, {r0-r1, lr}
     LDR     R1, [R12, #PoduleBase]
     LDR     R0, =VIAPCROffset
     ADD     R1, R1, R0
     MOV     R0, #VIAInterruptEnable
     STRB    R0, [R1]     ; enable interrupts in podule by driving CA2 low
     LDMFD   sp!, {r0-r1, pc}^

; calculate and store base address of acia
GetACIAAddr
; r1 = podule base
; r5 = which Port
     STMFD   sp!, {r1-r3, lr}
     LDR     R2, =ACIA_Offset
     ADD     r3, r12, r5, LSL#2     ; Port offset
     STR     r2, [r3, #UARTOffset] ; ACIA offset from podule base
     ADD     r1, r1, r2
     STR     r1, [r3, #UARTbase]   ; ACIA base address
     LDMFD   sp!, {r1-r3, pc}^

   LTORG

; calculate and store base address of acia
; Routine presumes that the podule ID must be either
; ProdType_MIDI or ProdType_UserPortAndMIDI
; no other possibility is treated
GetUARTAddr
; r0 = podule ID;
; r1 = podule base
; r5 = which Port
     STMFD   sp!, {r1-r3, lr}
     CMP     r0, #ProdType_MIDI
     LDREQ   r2, =MIDI_only_UARTOffset ; address depends on podule ID
     LDRNE   r2, =MIDI_UP_UARTOffset
     ADD     r3, r12, r5, LSL#2     ; Port offset
     STR     r2, [r3, #UARTOffset]   ;UART offset from podule base
     ADD     r1, r1, r2
     STR     r1, [r3, #UARTbase]   ;UART base address
     LDMFD   sp!, {r1-r3, pc}^

UnknownPodule ROUT
; podule id is unknown. Read the device address offset in the workspace and check it
; is in the range <podule base addr .. podule end addr>. If it is, accept it as valid.
; This way the module can support future hardware which just registers its device
; base address offsets via a custom MidiLog module (must be loaded before the Midi module)
; r5 = which Port
     STMFD   sp!, {r1-r5, lr}
     ADD     r2, r12, r5, LSL#2  ; Port offset
     LDR     r1, [r2, #UARTOffset] ; alternative UART base address supplied by MidiLog module
     CMP     r1, #0      ; check the supplied address offset is greater than 0
     BLT     BadPodule
     CMP     r1, #1:SHL:PoduleNumberShift ; size of podule address space
     BGE     BadPodule   ; check the offset is less than the podule address space
     LDR     R3, [R2, #PoduleBase]  ; base address of this podule
     ADD     r1, r1, r3
     TST     r1, #PortTypeTestBit
     BEQ     BadPodule  ; else it cannot be recognised as a Signetics UART podule
   ; accept existing address as OK
     STR     R1, [R2, #UARTbase]  ; base address of this podule
     LDMFD   sp!, {r1-r5, pc}^
BadPodule
; Let the user know that something untoward happened in finding the podule
; hardware base address.
     ADR     R0, ErrorBlock_BadPodule  ; Defined in error header file
     STR     R0, [sp]
     LDMFD   sp!, {R1-R5,lr}
     ORRS    pc, lr, #V_bit
     MakeErrorBlock BadPodule

; get hardware addresses
GetDeviceAddresses ROUT
     STMFD   sp!, {R1-R5,lr}
     LDR     r2, [r12, #ModeFlagBits]
; clear UART base addresses to zero to ensure they are recognised as uninitialised if read
     MOV     r0, #0
     MOV     r1, #0
     ADD     r3, r12, #UARTbase
     STMIA   R3!, {r0-r1}
     STMIA   R3!, {r0-r1}
     MOV     r5, r2, LSR#NExtraPortsShift ; get number of Ports installed
     AND     r5, r5, #3  ; range 0-3 . decremented to 0
20   ADD     r4, r12, r5, LSL#2
     LDR     r4, [r4, #PoduleBase]    ; podule base address
     MOV     r3, r4, LSR#PoduleNumberShift
     AND     r3, r3, #3  ; podule number is in range 0 -> 3
     ADD     r2, r12, #ScratchBuffer  ; put the podule ID in a buffer temporarily
     SWI     XPodule_ReadHeader  ; read the extended ID of the podule
     BVS     BadPodule       ; give up if SWI returned error
     LDR     r0, [r2]  ; this is the extended podule ID
     MOV     r0, r0, LSR#IDShift
     MOV     r1, r4       ; podule base address to r1
     CMP     r0, #ProdType_BBCIO   ; which podule is it
     BLEQ    GetACIAAddr  ; get acia base address
     BLEQ    VIAprogram   ; (enable podule irq by writing to VIA)
     BEQ     %FT10
     CMP     r0, #ProdType_MIDI
     CMPNE   r0, #ProdType_UserPortAndMIDI
     BLEQ    GetUARTAddr ; get UART base address
     BLNE    UnknownPodule ; podule ID is not directly supported; check the uart address supplied by MidiLog
10   SUBS    r5, r5, #1
     BPL     %BT20
     LDMFD   sp!, {R1-R5,pc}^

ResetACIA  ; r1 contains podule base
; r5 = which Port
     STMFD   sp!, {r0-r2, lr}
     ADD     r2, r12, r5, LSL#2     ; Port offset
     LDR     r1, [r2, #UARTbase]    ; ACIA base address
     MOV     R0, #ACIAResetValue
     STRB    R0, [R1]  ; poke reset value into ACIA control reg
     MOV     R0, #ACIAControlValue
     STRB    R0, [R1]  ; now poke control value into register
     ADD     r2, r12, r5     ; Port offset
     STRB    R0, [r2, #IMRCurrent] ; and store it in imrcurrent
     LDMFD   sp!, {r0-r2, pc}^

ResetUART  ; r0 contains podule ID; r1 contains podule base
; r5 = which Port
     STMFD   sp!, {r0-r2, lr}
     ADD     r2, r12, r5, LSL#2     ; Port offset
     LDR     R1, [R2, #UARTbase]   ;UART base address
     MOV     R0, #0
     STRB    R0, [R1, #IROffset]    ;mask all interrupts
     MOV     R0, #CRResetMR         ;reset MR pointer
     STRB    R0, [R1, #CROffset]
     MOV     R0, #CRResetRx         ;reset receiver
     STRB    R0, [R1, #CROffset]
     MOV     R0, #CRResetTx         ;reset transmitter
     STRB    R0, [R1, #CROffset]
     MOV     R0, #CRResetEr         ;reset error
     STRB    R0, [R1, #CROffset]
     MOV     R0, #CRResetBk         ;reset break bit in ISR
     STRB    R0, [R1, #CROffset]
     MOV     R0, #MR1               ;program default MR1 value
     STRB    R0, [R1, #MROffset]
     MOV     R0, #MR2               ;program default MR2 value
     STRB    R0, [R1, #MROffset]
     MOV     R0, #CSR               ;program default CSR value
     STRB    R0, [R1, #SROffset]
     MOV     R0, #ACR               ;program default ACR value
     STRB    R0, [R1, #ACROffset]
     MOV     R0, #CRenable          ; enable rx&tx
     STRB    R0, [R1, #CROffset]
     MOV     R0, #CTUR
     STRB    R0, [R1, #CTUOffset]   ; counter/timer upper byte
     MOV     R0, #CTLR
     STRB    R0, [R1, #CTLOffset]   ; counter/timer lower byte
     MOV     R0, #CRStartCT         ; load and start counter/timer
     STRB    R0, [R1, #CROffset]
     MOV     R0, #RxRDYirq
     STRB    R0, [R1, #IROffset]    ; program default interrupt mask
     ADD     r2, r12, r5            ; Port offset
     STRB    R0, [r2, #IMRCurrent]
     LDMFD   sp!, {r0-r2, pc}^

ResetSystem  ROUT  ; *****R12 must contain workspace pointer on entry*******
     STMFD   sp!, {R0-R5,lr}
     TEQP    pc, #I_bit:OR:3  ; disable interrupts, presume entered in svc mode
; get state that must be preserved through reset
     LDR     r2, [r12, #ModeFlagBits]
     LDR     r4, [r12, #Tuning]
     LDR     r5, [r12, #SoundConfiguration]
     MOV     R0, #0
     ADD     R3, R12, #SystemResetClearStart ; start of workspace to clear
     ADD     R1, R12, #SystemResetClearEnd ; end of workspace to clear.
ClearWorkSpace            ; nb must clear workspace BEFORE writing to it!
     STR     R0, [R3], #4
     CMP     R3, R1
     BLT     ClearWorkSpace
; restore previous state
     STR     r0, [r12, #Slot_p] ; reset scheduler
     MOV     r0, #-1
     STR     r0, [r12, #next_schedule_t]
     STR     r4, [r12, #Tuning]
     STR     r5, [r12, #SoundConfiguration]
; make a mask of state flag bits to keep
     MOV     r3, #Sound0Present:OR:Sound1Present:OR:Sound2Present ; preserve sound modules presence flags
     ORR     r3, r3, #ConnectionBit:OR:SoundEnableBit ; preserve sound connection state
     ORR     r3, r3, #FastClock:OR:Version3Facilities ; preserve fast clock state and new facilities
     ORR     r3, r3, #3:SHL:NExtraPortsShift ; preserve info on number of Ports installed
     AND     r3, r3, r2  ; state bits to be preserved
     MOV     r2, #DefaultMode
     ORR     r2, r2, r3
     MOV     r0, #7
     STRB    r0, [r12, #MonoChannels]   ; default 8 channels in mode 4
     MOVS    r0, #0 ; set Z
     BL      ClaimReleaseTimer ; enter with z set to release timer. Ignore any error
     BIC     r2, r2, #FastClock:OR:Version3Facilities ; reset fast clock state and new facilities
     STR     r2, [r12, #ModeFlagBits]
     MOV     r5, r2, LSR#NExtraPortsShift ; get number of Ports installed
     AND     r5, r5, #3  ; range 0-3 . decremented to 0
20   ADD     r4, r12, #UARTbase
     LDR     r4, [r4, r5, LSL#2]    ; uart base address
     TST     r4, #PortTypeTestBit     ; which Port it is
     BLEQ    ResetACIA  ; these routines reset ACIA or..
     BLNE    ResetUART  ; ..UART
     SUBS    r5, r5, #1
     BPL     %BT20
     MOV     R0, #IOC
     TEQP    pc, #F_bit:OR:I_bit:OR:3 ; disable fiq and irq
     LDRB    R1, [R0, #IOCIRQMSKB]  ; (this is modified in econet fiq code!)
     ORR     R1, R1, #podule_IRQ_bit
     STRB    R1, [R0, #IOCIRQMSKB]  ; enable podule irqs in ioc
     LDMFD   sp!, {R0-R5,pc}^   ; return with previous flags and mode

; *** insert irq code here ***
  GET <dir>.MidiPodule.IrqCode
; ****************************

DisableUartIrqs ROUT
; disable all irqs from all uarts or acias in midi Ports
; enter with:
; r8 = number of midi Ports installed
; r12 = wp 
     STMFD   sp!, {r2-r3, lr}
10   ADD     r2, r12, r8, LSL#2   ; Port address offset
     LDR     r2, [r2, #UARTbase] ; ACIA/UART base address
     TST     r2, #PortTypeTestBit
     MOVEQ   r3, #ACIAIRQdisable
     STREQB  r3, [r2]             ; disable all interrupts
     MOVNE   r3, #0
     STRNEB  r3, [r2, #IROffset]  ; disable all interrupts
     SUBS    r8, r8, #1
     BPL     %BT10                ; for each midi Port
; don't update IMR; this preserves the irq flags for re-enabling
     LDMFD   sp!, {r2-r3, pc}^

EnableUartIrqs ROUT
; re-enable all irqs from all uarts or acias in midi Ports
; enter with:
; r8 = number of midi Ports installed
; r12 = wp 
     STMFD   sp!, {r2-r4, lr}
     LDR     r3, [r12, #IMRCurrent]   ; 4 IMRs
10   MOV     r4, r8, LSL#3      ; X 8 for byte-shift
     MOV     r4, r3, LSR r4     ; IMR byte
     ADD     r2, r12, r8, LSL#2   ; Port address offset
     LDR     r2, [r2, #UARTbase] ; ACIA/UART base address
     TST     r2, #PortTypeTestBit
     STREQB  r4, [r2]             ; enable acia interrupts
     STRNEB  r4, [r2, #IROffset]  ; enable uart interrupts
     SUBS    r8, r8, #1
     BPL     %BT10                ; for each midi Port
; don't update IMR
     LDMFD   sp!, {r2-r4, pc}^

GetModuleWorkspacePointer
; find workspace address of co-module MIDIlog. This should contain addresses
; of any other Ports that this module was loaded from
     STMFD   sp!, {r1-r6,lr}
     MOV     r0, #ModHandReason_LookupName
     ADR     r1, MidiLogModuleName
     SWI     XOS_Module ; affects r0-r6
     LDMVSFD sp!, {r1-r6,lr}
     ORRVSS  pc, lr, #V_bit  ; return v-set if error
     CMP     r1, #0          ; module number should be > 0
     LDMLEFD sp!, {r1-r6,lr}
     ORRLES  pc, lr, #V_bit  ; return v-set if module not found
; return workspace pointer in r0
     MOV     r0, r4
     LDMFD   sp!, {r1-r6,pc}^
MidiLogModuleName  = "MIDILog",0
     ALIGN

TransferAddresses ROUT
; enter with r0 = midilog module workspace pointer
;            r1 = address of (this) podule from podule manager
;            r2 = my workspace pointer
; exit with r11 = number of midi Ports installed - 1
     STMFD   sp!, {r0-r6, lr}
     ADD     r5, r2, #PoduleBase
     MOV     r11, #0
     LDR     r3, =PoduleZeroAddress
; count the port addresses
01   LDR     r4, [r0, r11, LSL#2] ; get podule base address from midilog workspace
     CMP     r4, r3     ; test for sensible address
     SUBLT   r11, r11, #1 ; invalid address
     BLT     %FT02
     CMP     r1, r4     ; test if address from podule manager is the same as one I already have
     MOVEQ   r1, #0     ; if so, clear it
     STR     r4, [r5, r11, LSL#2] ; store in my workspace
     CMP     r11, #3
     ADDLT   r11, r11, #1 ; count of number of midi ports
     BLT     %BT01      ; loop
     B       %FT03  ; =>4 addresses in midilog; ignore supplied podule-manager address
02   CMP     r1, r3    ; valid new address?
; add podule manager (this) podule address
     ADDGE   r11, r11, #1    ; extra port
     STRGE   r1, [r5, r11, LSL#2]
; copy device (uart) address offsets from midilog workspace to my workspace
; These values are used for unknown podule types; else they are recalculated
; for known (Acorn) podule types in GetDeviceAddresses
03   ADD     r0, r0, #4*4
     ADD     r2, r2, #UARTOffset
     LDMIA   r0, {r3-r6}  ; get 4 words from the midi log workspace
     STMIA   r2, {r3-r6}  ; store in my workspace
     LDMFD   sp!, {r0-r6, pc}^

ClearSpace
; enter with r2 = wp
     STMFD   sp!, {r1-r6, lr}
     MOV     r3, #0
     MOV     r4, #0
     MOV     r5, #0
     MOV     r6, #0
     ADD     r1, r2, #PoduleBase
     STMIA   r1, {r3-r6} ; clear podule base addresses
     ADD     r1, r2, #UARTOffset
     STMIA   r1, {r3-r6} ; clear uart address offsets
     LDMFD   sp!, {r1-r6, pc}^

Initialise_Module ROUT
     STMFD   sp!, {r0-r6,lr}
     LDR     R2, [R12]     ; check for reinitialisation
     CMP     R2, #0   ; If R12^ contains zero then this is a new init
     BNE     SoftStart
     MOV     R0, #ModHandReason_Claim  ; claim space from module handler
     LDR     R3, WorkSpaceSize         ; R3 is size of space claimed
     SWI     XOS_Module
     BVS     CantGetWorkSpace
     STR     R2, [R12]
SoftStart ; reset system and relink to the vectors
     CMP     R11, #0      ; am I being initialised by the podule manager?
     MOVEQ   R11, #PoduleZeroAddress  ; if not assume podule is in slot 0
     LDR     R1, =Podule_BaseAddressBICMask
     BIC     R1, R11, R1     ;R11 has the base address (from the pod. manager)
; clear space for podule base addresses and uart offsets
     BL      ClearSpace
;get workspace pointer of MIDILog module in r0
     BL      GetModuleWorkspacePointer
     STRVS   r1, [r2, #PoduleBase] ; error midilog module not found, store this podule base
; r0 = workspace pointer of MIDILog module
; r1 = podule address from podule manager
; transfer up to 4 podule base addresses + 4 acia/uart addresses
; from the midi address log module workspace to my workspace
     BLVC    TransferAddresses  ; get Port addresses from MidiLog module
; returned with r11 = number of ports installed - 1 (0..3)

; get buffer space for each Port
; r11 = number of Ports installed - 1
     ADDS    r6, r11, #1 ; number of Ports installed (also clears V-flag)
; get tx buffer space
     MOV     r5, #TxBufferLen
     ADD     r4, r2, #TxBufferStarts
; enter ClaimBuffers with
;   r5 = size of buffers to claim
;   r6 = number of buffers to claim
;   r4 = address of workspace pointers to starts of 4 buffers (though there will usually be fewer)
; exit with v - set if unable to claim buffers
;   r5 = total space claimed (bytes) (ignored here)
     BL      ClaimBuffers
     BVS     CantGetWorkSpace
; get rx buffer space
     MOV     r5, #DefaultRxBufferLen
     STR     r5, [r2, #RxBufferLen]
     ADD     r4, r2, #RxBufferStarts
     BL      ClaimBuffers
; if error free tx buffers and exit
     ADDVS   r4, r2, #TxBufferStarts
     BLVS    FreeBuffers
     BVS     CantGetWorkSpace
; get rx-times buffer space
     MOV     r5, #DefaultRxBufferLen:SHL:2
     ADD     r4, r2, #RxTimesBufferStarts
     BL      ClaimBuffers
; if error free tx buffers and rx buffers
     ADDVS   r4, r2, #TxBufferStarts
     BLVS    FreeBuffers
     ADDVS   r4, r2, #RxBufferStarts
     BLVS    FreeBuffers
     BVS     CantGetWorkSpace

40   MOV     r12, r2
     MOV     r5, #DefaultMode
     ORR     r5, r5, r11, LSL#NExtraPortsShift ; store number of extra installed Ports
     MOV     r0, #0
     SWI     XSound_Tuning  ; get value of tuning parameter (sound level 1)
     BLVS    FreeAllBuffers
     STRVS   r0, [sp]        ; return error^
     LDMVSFD sp!, {r0-r6, pc} ; go straight back to caller, as no vectors
                              ; have been claimed. V is set
     STR     R0, [R12, #Tuning]
     ORR     r5, r5, #Sound1Present

     BL      GetConfig    ; read sound sys channel num configuration
     BLVS    FreeAllBuffers
     STRVS   r0, [sp]        ; return error^
     LDMVSFD sp!, {r0-r6, pc} ; go straight back to caller, as no vectors
                              ; have been claimed. V is set
     ADR     r0, IrqRoutinePos
 ; can't do adr of IrqVectorCode since it is more than &FF words away
     LDR     r1, [r0]       ; this location contains size of irq routine
     SUB     r1, r0, r1  ; true address of irq vector code
;       ADR     r1, IRQVectorCode
     MOV     r0, #IrqV
     SWI     XOS_Claim       ; link to the irq vector
     BLVS    FreeAllBuffers
     STRVS   r0, [sp]        ; return error^
     LDMVSFD sp!, {r0-r6, pc} ; go straight back to caller, as no vectors
                              ; have been claimed. V is set
     ADR     r0, CentisecondCodePos
     LDR     r1, [r0]
     SUB     r0, r0, r1
     STR     r0, [r12, #csRoutineAddr] ; start of workspace and contains pointer to cs rountine
; read sound configure level 2 entry point, and send the sirq to the centisecond routine
     MOV     r0, #0
     MOV     r1, #0
     MOV     r2, #0
     MOV     r3, #0
     MOV     r4, r12   ; centisecond routine address is here at the start of the workspace
     SWI     XSound_Configure   ; sound level 0
     BLVS    FreeAllBuffers
     BVS     VectorClaimFail
     STR     r4, [r12, #Sound_QTick]  ; (workspace) address to call sound scheduler with
     ORR     r5, r5, #Sound0Present ; register presence of sound 0
     CMP     r4, #SoundSystemNIL  ; check if sound scheduler has registered with sounddma
     ORRNE   r5, r5, #Sound2Present ; if so presume sound scheduler is installed

     MOV     r2, r12     ; restore wp pointer
     MOV     r0, #EventV
     ADR     r1, EventHandler
     SWI     XOS_Claim       ; link to the event vector
     BLVS    FreeAllBuffers
     BVS     VectorClaimFail

     MOV     r0, #OsbyteEnableEvent
     MOV     r1, #Event_Escape
     SWI     XOS_Byte        ; enable escape event
     BLVS    FreeAllBuffers
     BVS     VectorClaimFail ;but dont try to disable escape event if it failed

     MOV     r0, #OsbyteEnableEvent
     MOV     r1, #Event_Sound
     SWI     XOS_Byte        ; enable sound system bar change event
     BVC     NoInitErr
     MOV     r0, #OsbyteDisableEvent
     MOV     r1, #Event_Escape
     SWI     XOS_Byte        ; must disable escape event if it failed
     BL      FreeAllBuffers
     B       VectorClaimFail
NoInitErr
     STR     r5, [r12, #ModeFlagBits]
     BL      GetDeviceAddresses  ; this discovers which podule it is from the ID
     BLVC    ResetSystem
     BLVS    FreeAllBuffers
     BVS     ResetFail   ;  if  V set then exit with fatal error
     MOV     r0, #Service_MIDIAlive
     MOV     r1, #Service_MIDI
     SWI     XOS_ServiceCall   ; warn of initialisation to any applications using
                               ; a tightly-coupled interface to MIDI
     LDMFD   sp!, {r0-r6, PC}^ ; return if claimed OK
VectorClaimFail
     STR     r0, [sp]        ; return error^
     MOV     r2, r12
     BL      DiscardVectors
     B       ErrorExitInit
CantGetWorkSpace
     ADR     r0, ErrorBlock_MHNoRoom  ; Defined in error header file
     STR     R0, [sp]
     B       ErrorExitInit
     MakeErrorBlock MHNoRoom
ResetFail                 ; fatal error. Abort in initialise
     STR     r0, [sp]        ; return error^
     MOV     r0, #OsbyteDisableEvent
     BL      SetEvents
     BL      DiscardVectors
ErrorExitInit
     LDMFD   sp!, {r0-r6, lr}
     ORRS    pc, lr, #V_bit  ; Ensure caller sees the error

     LTORG

ClaimBuffers
; enter with
;   r5 = size of buffers to claim
;   r6 = number of buffers to claim
;   r4 = address of workspace pointers to 4 buffers
; exit with v - set if unable to claim buffers
;   r5 = total space claimed (bytes)
     STMFD   sp!, {r0-r4, lr}
; multiply r6 x BufferLen (r6 = 1..4)
     CMP     r6, #2
     MOVLT   r3, r5                             ; r6 = 1
     MOVEQ   r3, r5, LSL#1     ; = 2*BufferLen  ; r6 = 2
     RSBGT   r3, r5, r5, LSL#2 ; = 3*BufferLen  ; r6 = 3
     CMPGT   r6, #3
     MOVGT   r3, r5, LSL#2     ; = 4*BufferLen  ; r6 = 4
; get space for n DefaultRxbuffers
     MOVS    r0, #ModHandReason_Claim
     SWI     XOS_Module
     LDMVSFD sp!, {r0-r4, pc} ; return v-set if error
; set up buffer pointers as if for four buffers (usually there will be fewer)
     MOV     r0, r2
     ADD     r1, r2, r5
     STMIA   r4!, {r0-r1} ; store buffer pointers
     ADD     r0, r1, r5
     ADD     r1, r0, r5
     STMIA   r4, {r0-r1} ; store buffer pointers
     MOV     r5, r3      ; total space claimed
     LDMFD   sp!, {r0-r4, pc}^

FreeBuffers
; enter with:
;   r4 = address of workspace pointer to buffer block
     STMFD   sp!, {r0-r4, lr}
     LDR     r2, [r4] 
     MOV     r0, #ModHandReason_Free
     SWI     XOS_Module
     LDMFD   sp!, {r0-r4, pc}^ ; ignore error

FreeAllBuffers
     STMFD   sp!, {r4, lr}
     ADD   r4, r12, #TxBufferStarts
     BL    FreeBuffers
     ADD   r4, r12, #RxBufferStarts
     BL    FreeBuffers
     ADD   r4, r12, #RxTimesBufferStarts
     BL    FreeBuffers
     LDMFD   sp!, {r4, pc}^ ; ignore error

IrqRoutinePos & . - IRQVectorCode  ; to bring distant label into adr range
CentisecondCodePos & . - CentisecondCode

Intercept_Services ROUT
     CMP     r1, #Service_PreReset
     BNE     %FT10
; On a break it should reset the hardware in the podule to give the effect of a hard reset
     STMFD   sp!, {lr}
     LDR     r12, [r12]         ; workspace pointer
     BL      ResetHardware
     LDMFD   sp!, {pc}^    ; return

10   CMP     R1, #Service_Reset ; check for the Reset service call
     BNE     %FT20
     STMFD   sp!, {R0-R3, lr}   ; if reset, then it is no longer linked to the vectors
     LDR     R2, [R12]         ; workspace pointer
     MOV     r12, r2
     ADR     r0, IrqRoutinePos
 ; can't do adr of IrqVectorCode since it is more than &FF words away
     LDR     r1, [r0]       ; this location contains size of irq routine
     SUB     r1, r0, r1  ; true address of irq vector code
     MOV     R0, #IrqV
     SWI     XOS_Claim     ; link to the irq vector
     ADR     R1, EventHandler
     MOV     R0, #EventV
     SWI     XOS_Claim    ; link to the event vector
     MOV     R0, #OsbyteReadLastBreak
     MOV     R1, #0
     MOV     R2, #255
     SWI     XOS_Byte ; only re-enable events if the last break was soft,
; hard breaks, and power-on reset do initialise first, so must not re-enable. 
     CMP     R1, #0        ; => last break was soft, so enable events.
     MOVEQ   R0, #OsbyteEnableEvent
     BLEQ    SetEvents
     BLEQ    ResetSystem        ; Not worth doing System Reset twice either
     LDMFD   sp!, {R0-R3, PC}^ ; return

20   CMP     R1, #Service_Sound ; check for the sound system dying service call
     MOVNES  PC, lr
     STMFD   sp!, {r0-r5,lr}
     LDR     r12, [r12]         ; workspace pointer
; fixup pointers on sound system initialise and die service calls
; catch the sound scheduler initialise service call and reset its pointer in level 0
     LDR     r5, [r12, #ModeFlagBits]

     CMP     r0, #Service_SoundLevel0Alive
     ORREQ   r5, r5, #Sound0Present
     BEQ     %FT30

     CMP     r0, #Service_SoundLevel0Dying
     BICEQ   r5, r5, #Sound0Present
     BEQ     %FT40

; re-initialising Sound1 does not restore the voices.
; once Sound1 disappears, voices will have to be reinitialised to restore voice function
     CMP     r0, #Service_SoundLevel1Alive
     ORREQ   r5, r5, #Sound1Present
     BEQ     %FT40

     CMP     r0, #Service_SoundLevel1Dying
     BICEQ   r5, r5, #Sound1Present
     BEQ     %FT40

     CMP     r0, #Service_SoundLevel2Alive
     ORREQ   r5, r5, #Sound2Present
     BEQ     %FT30

     CMP     r0, #Service_SoundLevel2Dying
     BICEQ   r5, r5, #Sound2Present
     MOVEQ   r0, #SoundSystemNIL
     STREQ   r0, [r12, #Sound_QTick]
     B       %FT40

30   ADR     r0, CentisecondCode
     STR     r0, [r12, #csRoutineAddr] ; start of workspace and contains pointer to cs rountine
     MOV     r4, #SoundSystemNIL
     STR     r4, [r12, #Sound_QTick]  ; reset tick entry
; read sound configure level 2 entry point, and send the sirq to the centisecond routine
     MOV     r0, #0
     MOV     r1, #0
     MOV     r2, #0
     MOV     r3, #0
     MOV     r4, r12   ; centisecond routine address is here at the start of the workspace
     SWI     XSound_Configure   ; sound level 0
     CMP     r4, #SoundSystemNIL
     CMPNE   r4, r12   ; ensure centisecond code is not infinitely re-entered!
     STRNE   r4, [r12, #Sound_QTick]  ; (workspace) address to call sound scheduler with
     BICVS   r5, r5, #Sound0Present
     ORRVC   r5, r5, #Sound0Present ; register presence of sound 0

40   STR     r5, [r12, #ModeFlagBits]
     LDMFD   sp!, {r0-r5,pc}^

Finalise_Module  ROUT
     STMFD   sp!, {r0-r4, lr}
     LDR     R2, [R12]
     MOV     r12, r2
     MOV     r0, #Service_MIDIDying
     MOV     r1, #Service_MIDI
     SWI     XOS_ServiceCall   ; warn of impending doom to any applications using
                               ; a tightly-coupled interface to MIDI
     MOV     r0, #Timer1_DevNo ; timer 1 release
     ADR     r1, Ms_Handler    ; millisecond handler
     SWI     XOS_ReleaseDeviceVector ; release and ignore possible error
; free 3 sets of buffers claimed from rma
     BL      FreeAllBuffers
     BL      DoAllNotesOff        ; switch off all midi-initiated notes when the module disappears
     BL      ResetHardware
     MOV     r0, #OsbyteDisableEvent
     BL      SetEvents
     BL      DiscardVectors
; restore config.
     MOV     r0, #0
     MOV     r1, #0
     MOV     r2, #0
     MOV     r3, #0
     LDR     r4, [r12, #Sound_QTick]
     SWI     XSound_Configure ; ignore errors
     LDR     r0, [r12, #ModeFlagBits]
     TST     r0, #SoundEnableBit    ; test if sound sys is enabled
     LDRNE   r3, [r12, #SoundConfiguration]
     BLNE    SetConfig              ; restore number of channels enabled
     LDMFD   sp!, {r0-r4, pc}^

DiscardVectors ; Must enter with r2 pointing to workspace
     STMFD   sp!, {r0,r1,lr}
     ADR     r0, IrqRoutinePos
 ; can't do adr of IrqVectorCode since it is more than &FF words away
     LDR     r1, [r0]       ; this location contains offset of irq routine
     SUB     r1, r0, r1  ; true address of irq vector code
     MOV     R0, #IrqV
     SWI     XOS_Release    ; release from the irq vector
     ADR     R1, EventHandler
     MOV     R0, #EventV
     SWI     XOS_Release    ; release from the event vector
     LDMFD   sp!, {r0,r1,PC}^  ; return without error.
; Errors from XOS_Release should be ignored, as they may prevent this module
; from being removed if it yielded an error from Finalise

ResetHardware ROUT ; Disable podule irqs in all Ports I know about.
; Workspace pointer in r12
     STMFD   sp!, {r0-r3, lr}
     ADD     r1, r12, #UARTbase
     ADD     r2, r1, #16  ; end of list of 4 addresses
10   LDR     r0, [r1], #4 ; base address of uart/acia
     AND     r3, r0, #&FF000000  ; detect invalid Port address
     CMP     r3, #&03000000
     LDMNEFD sp!, {r0-r3, pc}^   ; and exit
     TST     r0, #PortTypeTestBit     ; which Port is it?
; disable ACIA irqs
     MOVEQ   r3, #ACIAIRQdisable
     STREQB  r3, [r0] ; disable ACIA interrupts
     MOVEQ   r3, #ACIAResetValue
     STREQB  r3, [r0] ; reset ACIA
; disable UART irqs
20   MOVNE   r3, #0
     STRNEB  r3, [r0, #IROffset] ; dont bother about imrcurrent; this is fatal.
     MOVNE   r3, #CRResetRx
     STRNEB  r3, [r0, #CROffset]
     MOVNE   r3, #CRResetTx
     STRNEB  r3, [r0, #CROffset]
     MOVNE   r3, #CRdisable
     STRNEB  r3, [r0, #CROffset]
     CMP     r1, r2 
     BLT     %BT10
     LDMFD   sp!, {r0-r3, pc}^

SetEvents ROUT ; enter with r0=disable or enable
 ; Must only disable events if we've really enabled them, as enable/disable are
 ; inc/dec calls on a counter. Someone else may need the event too !
     STMFD   sp!, {r0-r3, lr}
     MOV     r3, r0
     MOV     r1, #Event_Escape
     SWI     XOS_Byte                  ; osbyte corrupts r0-r2
     MOV     r0, r3
     MOV     r1, #Event_Sound
     SWI     XOS_Byte
     LDMFD   sp!, {r0-r3, pc}^

EventHandler
     CMP     r0, #Event_Escape
     BEQ     EscapeHandler
     CMP     r0, #Event_Sound
     MOVNES  pc, lr
; bar event handler
     STMFD   sp!, {r0, lr}
     LDR     r0, [r12, #CurrentQBeat]
     ADD     r0, r0, #1:SHL:16      ; add 1 to bar count
     STR     r0, [r12, #CurrentQBeat]
     LDMFD   sp!, {r0, pc}^
EscapeHandler
     STMFD   sp!, {r0-r3, lr}
;change to svc mode and save lr so that it can be restored at the end
; in case it was interrupted from an svc-mode routine, since I make a swi
; call which will corrupt lr_svc
     MOV     r3, pc     ; remember caller's mode
     TEQP    PC, #I_bit:OR:3    ; change to svc mode (mode3) retaining irq off
     MOV     R0, #0       ; also does regbank delay
     STRB    R0, [R12, #VoiceStates] ; escape kills voices so clear voicestates
     STMFD   sp!, {lr}  ; stack lr_svc value
; need to set escape condition as the OS only sets this if the escape event
; is disabled ...
     MOV     R0, #OsbyteSetEscapeCondition
     SWI     XOS_Byte  ; set escape condition. corrupts r1,r2 !
     LDMFD   sp!, {lr}  ; restore lr_svc value
     TEQP    r3, #0     ; Back to caller's mode
     MOVNV   R0, R0    ; delay for regbank to change
     LDMFD   sp!, {r0-r3, pc}^  ;must save 3 regs because osbyte corrupts them

; setup timer irq handler
; r12 contains wp
; claim or release device vector depending on z flag state
; return errors from swis
; r0 corrupted
ClaimReleaseTimer ROUT ; enter with z clear to claim; z set to release
     STMFD   sp!, {r0-r3,lr}
; check that Fast Clock flag is set if releasing; clear if claiming; otherwise exit.
; Reproduce expected state in r0
     MOVEQ   r0, #FastClock  ; z-set  (release, so fc should be set) => set fc bit
     MOVNE   r0, #0          ; z-clear (claim, so fc should be clear) => clear fc bit
     TEQP    pc, #I_bit:OR:3  ; Disable irq for mode flags update. Entry must be in svc mode
     LDR     r3, [r12, #ModeFlagBits]
     AND     r1, r3, #FastClock  ; get fastclock bit
     TEQ     r1, r0              ; test fastclock bit
     LDMNEFD sp!, {r0-r3,pc}^ ; return if state of fc bit is not as expected
     MOVS    r0, r0    ; set z if fc clear (claim) (z inverted from entry state)
     MOV     r1, #IOC 
     LDRB    r0, [r1, #IOCIRQMSKA]
     BIC     r0, r0, #timer1_bit
     STRB    r0, [r1, #IOCIRQMSKA]  ; disable timer irqs in ioc
     MOV     r0, #Timer1_DevNo ; timer 1 interrupt me
     ADR     r1, Ms_Handler    ; millisecond handler
     MOV     r2, r12           ; workspace pointer
     SWIEQ   XOS_ClaimDeviceVector
     STRVS   r0, [sp]         ; push error back on stack
     LDMVSFD sp!, {r0-r3,pc}  ; return with error
     ORREQ   r3, r3, #FastClock ; set flag
     SWINE   XOS_ReleaseDeviceVector
     STRVS   r0, [sp]         ; push error back on stack
     LDMVSFD sp!, {r0-r3,pc}  ; return with error
     BICNE   r3, r3, #FastClock ; clear flag if error or not
     STR     r3, [r12, #ModeFlagBits]
     LDMFD   sp!, {r0-r3,pc}^

; load value into timer and start it. IRQ will be generated
; at 1ms intervals
StartTimerIRQ ROUT
     STMFD r13!, {r0-r1,lr}
     MOV   r1, #IOC 
     MOV   r0, #TimerTicksFor1ms:SHR:8 ; msb
     STRB  r0, [r1, #Timer1LH]
     MOV   r0, #TimerTicksFor1ms       ; lsb
     STRB  r0, [r1, #Timer1LL]
     STRB  r0, [r1, #Timer1GO]         ; start timer going
     LDRB  r0, [r1, #IOCIRQMSKA]
     ORR   r0, r0, #timer1_bit
     STRB  r0, [r1, #IOCIRQMSKA]  ; enable timer irqs in ioc
     LDMFD r13!, {r0-r1,pc}^

; Note that r12 contains direct workspace pointer, NOT indirected.
; r0-r3 corruptible
; r3 contains IOC address
; ms_count, tc_rate and ModeFlagBits must be adjacent in workspace for ldm
; efficiency is IMPORTANT. This is called every ms
; so it is highly optimised to use ldm/stm wherever possible. Loops are unwound
Ms_Handler ROUT
     LDRB    r0, [r3, #IOCIRQREQA]
     TST     r0, #timer1_bit      ; is this my irq?
     MOVEQS  pc, lr
     STMFD   sp!, {r4-r5,lr}
     MOV     r0, #timer1_bit
     STRB    r0, [r3, #IOCIRQCLRA]  ; clear timer irq in ioc
     ADD     r2, r12, #ms_count ; workspace address
; load ms_count, tc_rate, ModeFlagBits and next_schedule_t quickly
     LDMIA   r2, {r0, r1, r3, r4}
     ADDS    r0, r0, #1         ; inc ms_count
     MOVMI   r0, #0             ; reset when it goes negative
; check if it is time to get the next scheduled command
     MOVS    r4, r4       ; test if positive
     BMI     %FT10        ; negative = disabled
     CMP     r4, r0       ; compare next schedule time with current time
     BGT     %FT10

     TEQP    pc, #I_bit + SVC_mode  ; change to svc mode; (check mode-change delay)
     MOVNV   r0, r0
     STMFD   sp!, {r0, lr} ; save svc-mode lr
    ; current time in r0
; Does it need to disable uart irqs here? I don't think it is necessary, so let's not bother
     BL      SchedulerTake  ; execute the scheduled commands up to this time
     LDMFD   sp!, {r0, lr}
     TEQP    pc, #I_bit + IRQ_mode  ; (check delay)

10   TST     r3, #InternalCount  ;return if not internal count set
     STMEQIA r2, {r0}           ; store ms_count
     LDMEQFD sp!, {r4-r5,pc}^
; check if it is time to send a timing clock message
; top 16 bits is incrementing ms count.
; bottom 16 bits is time at which to send TC
     TST     r1, #&FF        ; return if tc_rate is 0
     TSTEQ   r1, #&FF00
     STMEQIA r2, {r0}       ; store ms_count
     LDMEQFD sp!, {r4-r5,pc}^ ; return
     ADD     r1, r1, #&10000    ; increment
     CMP     r1, r1, LSL#16     ; compare with tc_rate
     BICGE   r1,r1,#&FF000000   ; reset count if reached value
     BICGE   r1,r1,#&00FF0000
     STMLTIA r2, {r0, r1}       ; store ms_count and tc_rate quickly
     LDMLTFD sp!, {r4-r5,pc}^
; send a timing clock
     TST     r3, #SendRT   ; preserve any existing rt instruction
     ORREQ   r3, r3, #SendTC   ; else instruct irq routine to send a tc byte
     STMIA   r2, {r0,r1,r3}    ; restore relevant data quickly
; enable podule irqs to send tcs from all
     MOV     r4, r3, LSR#NExtraPortsShift
     AND     r4, r4, #3        ; number of installed midi Ports
     MOV     r2, #0            ; this will be the 4 IMR bytes

; unwound loop for speed
     ADD     r1, r12, r4, LSL#2  ; Port offset
     LDR     r0, [r1, #UARTbase]
     TST     r0, #PortTypeTestBit
; acia
     MOVEQ   r3, #ACIATxIRQEnable
     STREQB  r3, [r0]             ; enable TDRE interrupts
; uart
     MOVNE   r3, #RxRDYirq:OR:TxRDYirq
     STRNEB  r3, [r0, #IROffset]  ; enable TxRDY interrupts
     MOV     r1, r4, LSL#3       ; Port number X 8 for byte shift
     ORR     r2, r2, r3, LSL r1  ; put IMR byte into word
     SUBS    r4, r4, #1
     STRMI   r2, [r12, #IMRCurrent]
     LDMMIFD sp!, {r4-r5,pc}^  ; 1 Port return

     ADD     r1, r12, r4, LSL#2  ; Port offset
     LDR     r0, [r1, #UARTbase]
     TST     r0, #PortTypeTestBit
     MOVEQ   r3, #ACIATxIRQEnable
     STREQB  r3, [r0]             ; enable TDRE interrupts
     MOVNE   r3, #RxRDYirq:OR:TxRDYirq
     STRNEB  r3, [r0, #IROffset]  ; enable TxRDY interrupts
     MOV     r1, r4, LSL#3       ; Port number X 8 for byte shift
     ORR     r2, r2, r3, LSL r1  ; put IMR byte into word
     SUBS    r4, r4, #1
     STRMI   r2, [r12, #IMRCurrent]
     LDMMIFD sp!, {r4-r5,pc}^  ; 2 Ports return

     ADD     r1, r12, r4, LSL#2  ; Port offset
     LDR     r0, [r1, #UARTbase]
     TST     r0, #PortTypeTestBit
     MOVEQ   r3, #ACIATxIRQEnable
     STREQB  r3, [r0]             ; enable TDRE interrupts
     MOVNE   r3, #RxRDYirq:OR:TxRDYirq
     STRNEB  r3, [r0, #IROffset]  ; enable TxRDY interrupts
     MOV     r1, r4, LSL#3       ; Port number X 8 for byte shift
     ORR     r2, r2, r3, LSL r1  ; put IMR byte into word
     SUBS    r4, r4, #1
     STRMI   r2, [r12, #IMRCurrent]
     LDMMIFD sp!, {r4-r5,pc}^  ; 3 Ports return
; last repeat
; Port number must be 0 by now. there are some optimisations
     LDR     r0, [r12, #UARTbase]
     TST     r0, #PortTypeTestBit
     MOVEQ   r3, #ACIATxIRQEnable
     STREQB  r3, [r0]             ; enable TDRE interrupts
     MOVNE   r3, #RxRDYirq:OR:TxRDYirq
     STRNEB  r3, [r0, #IROffset]  ; enable TxRDY interrupts
     ORR     r2, r2, r3           ; put IMR byte (0) into word
     STR     r2, [r12, #IMRCurrent]
     LDMFD   sp!, {r4-r5,pc}^  ; 4 Ports return

; ** centisecond code is included here **

    GET  <dir>.MidiPodule.SIRQCode

; ***************************************

; ***** interpreter is included here ****

   GET     <dir>.MidiPodule.Interpret

; ***************************************

DoAllNotesOff
     STMFD   sp!, {R0-R5, lr}
     LDR     r0, [r12, #ModeFlagBits]
     AND     r0, r0, #Sound2Present:OR:Sound1Present:OR:Sound0Present
     CMP     r0, #Sound2Present:OR:Sound1Present:OR:Sound0Present
     LDMNEFD sp!, {R0-R5, pc}^ ; return if all of sound system not present
     TEQP    pc, #I_bit:OR:3      ; disable irq
     MOV     R0, #ImmediateScheduleTime ; schedule for immediate action
     MOV     R5, #0      ; channel
     LDRB    R4, [R12, #VoiceStates]
NextVoice
     MOV     R1, #1
     TST     R4, R1, LSL R5  ; test if voice is on
     ADDNE   R3, R12, #VoiceSPitches
     LDRNE   R3, [R3, R5, LSL#2]  ; load pitch from VoiceSPitches
     ADD     R5, R5, #1
     ORRNE   R3, R3, #OffDuration:SHL:16         ; duration/pitch
     ORRNE   R2, R5, #GatedOffAmplitude:SHL:16  ; amp/channel
     MOV     R1, #0      ; cause a XSound_controlpacked swi
     SWINE   XSound_QSchedule
     LDMVSFD sp!, {R0-R5, PC}^  ; return if v set, but ignore error
     CMP     R5, #MaxVoices
     BLT     NextVoice
     MOV     R4, #0
     STRB    R4, [R12, #VoiceStates]
     LDMFD   sp!, {R0-R5, PC}^


; *** swi code is included here ****

   GET     <dir>.MidiPodule.SWICode

; **********************************


; ** the workspace definition is included here **

   GET     <dir>.MidiPodule.WorkSpace

; ***********************************************

  END
